Option Explicit




Sub test()
    Application.EnableEvents = True
End Sub



Private Sub Worksheet_Change(ByVal Target As Range)
    '斗志
    'Const Root_RNG As String = "B2"
    'Const Son_RNG As String = "H2"
    'Const ShtNm As String = "参数表"
    '
    'Const Word As String = "斗志"
    
    Application.EnableEvents = False
    
    '    If Target.Count = 1 Then
    '        If Target.Address = Range(Root_RNG).Address Then
    '                Range(Son_RNG).Value = Range(Root_RNG).Value
    '        End If
    '    End If
    
    Call 种族成长值
    Call 战斗职业成长值
    Call 生活职业成长值t
    Call 攻击主属性调整
    
    Application.EnableEvents = True
    
End Sub


Private Sub 攻击主属性调整()
    Const Race_Name As String = "B2"
    Const Main_Property As String = "F2"
    If Range(Race_Name).Value = "丧尸" Then
        Range(Main_Property).Value = "力量"
    End If
    
End Sub

Private Sub 种族成长值()
    '种族等级100级
    '1级种族10点
    '2级种族15点
    '3级种族20点
    
    Dim cCol%, cRow%
    Dim aRace()
    Dim i%
    Const Race_Name As String = "B2"
    cRow = 6
    cCol = 1
    aRace() = Sheets("种族库").Range("种族表").Value
    For i = 1 To UBound(aRace)
        If Range(Race_Name).Value = aRace(i, 1) Then
            Cells(cRow, cCol + 1) = aRace(i, 2)    '感知
            Cells(cRow + 1, cCol + 1) = aRace(i, 3)  '智力
            Cells(cRow + 2, cCol + 1) = aRace(i, 4)  '理性
            Cells(cRow + 3, cCol + 1) = aRace(i, 5)  '力量
            Cells(cRow + 4, cCol + 1) = aRace(i, 6)  '敏捷
            Cells(cRow + 5, cCol + 1) = aRace(i, 7)  '耐力
            Cells(cRow + 6, cCol + 1) = aRace(i, 8)  '魅力
            Cells(cRow + 7, cCol + 1) = aRace(i, 9)  '协调
            Cells(cRow + 8, cCol + 1) = aRace(i, 10)  '定力
            Cells(cRow, cCol + 10) = aRace(i, 11) '寿命极限"
            Cells(cRow + 1, cCol + 10) = aRace(i, 12) '生育率"
        End If
    Next i
    
End Sub



Private Sub 战斗职业成长值()
    '职业等级10级
    '平均1职业等级相当于种族5级
    Dim aFightJobs()
    Dim cCol%, cRow%
    Dim i%
    Const Fighting_Classes As String = "C2"
    cRow = 6
    cCol = 4
    
    aFightJobs() = Sheets("战斗职业库").Range("战斗职业表").Value
    '下面是战斗职业，属于主人技能
    '战斗职业给25点属性修正
    '必须有一项属性-10法则
    'Stop
    For i = 1 To UBound(aFightJobs)
        If Range(Fighting_Classes).Value = aFightJobs(i, 1) Then
            Cells(cRow - 4, cCol + 2) = aFightJobs(i, 2)  '主属性
            Cells(cRow, cCol) = aFightJobs(i, 3)     '感知
            Cells(cRow, cCol + 1) = aFightJobs(i, 4)    '理性
            Cells(cRow + 1, cCol) = aFightJobs(i, 5)   '智力
            Cells(cRow + 3, cCol) = aFightJobs(i, 6)   '力量
            Cells(cRow + 4, cCol) = aFightJobs(i, 7)   '敏捷
            Cells(cRow + 5, cCol) = aFightJobs(i, 8)   '耐力
            Cells(cRow + 6, cCol) = aFightJobs(i, 9)   '魅力
            Cells(cRow + 7, cCol) = aFightJobs(i, 10)   '协调
            Cells(cRow + 8, cCol) = aFightJobs(i, 11)   '定力
        End If
    Next i
End Sub



Sub 生活职业成长值t()
    '职业等级10级
    '平均1职业等级相当于种族5级
    '定义字典
    Dim aLifeJobs()
    Dim dRank As Object, dJobs As Object, dPolitical As Object, dNull As Object
    Dim i%, i1%
    Const Life_Classes As String = "D2"
    Const Rank_Classes As String = "E2"
    aLifeJobs() = Sheets("生活职业库").Range("生活职业表").Value
    Set dRank = CreateObject("Scripting.Dictionary")
    Set dJobs = CreateObject("Scripting.Dictionary")
    Set dPolitical = CreateObject("Scripting.Dictionary")
    Set dNull = CreateObject("Scripting.Dictionary")
    Dim rg As Range
    dRank("") = ""
    For Each rg In Sheets("参数表").Range("参数表[职业路线]")
        If Not dRank.exists(rg.Value) Then
            dRank(rg.Value) = ""
        End If
    Next
    dRank.Remove ("")
    Range(Rank_Classes).Validation.Delete
    Range(Rank_Classes).Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
    xlBetween, Formula1:=Join(dRank.keys, ",")
    
    
    For i = 1 To UBound(aLifeJobs)
        If aLifeJobs(i, 2) = "下品" Then
            For i1 = 3 To UBound(aLifeJobs, 2) - 1
                dJobs(aLifeJobs(i, 1)) = dJobs(aLifeJobs(i, 1)) & aLifeJobs(i, i1) & ","
            Next i1
            
        ElseIf aLifeJobs(i, 2) = "上品" Then
            For i1 = 3 To UBound(aLifeJobs, 2) - 1
                dPolitical(aLifeJobs(i, 1)) = dPolitical(aLifeJobs(i, 1)) & aLifeJobs(i, i1) & ","
            Next i1
        ElseIf aLifeJobs(i, 2) = "无" Then
            For i1 = 3 To UBound(aLifeJobs, 2) - 1
                dNull(aLifeJobs(i, 1)) = dNull(aLifeJobs(i, 1)) & aLifeJobs(i, i1) & ","
            Next i1
        End If
        
    Next i
    
    Dim cCol%, cRow%
    
    Dim sTemp$, aTemp() As String
    cRow = 6
    cCol = 5
    '下面是生活职业，属于奴隶技能
    '生活职业每级会给人物带来2.5属性
    '必须有一项属性-1法则
    
    
    If Range(Rank_Classes) = "下品" Then
        Range(Life_Classes).Validation.Delete
        Range(Life_Classes).Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:=Join(dJobs.keys, ",")
        
        If dJobs.exists(Range(Life_Classes).Value) Then  '0点
            sTemp = Left(dJobs(Range(Life_Classes).Value), Len(dJobs(Range(Life_Classes).Value)) - 1)
            aTemp = Split(sTemp, ",")
            For i = 0 To 8
                Cells(cRow + i, cCol) = CInt(aTemp(i))
            Next i
        End If
        
    ElseIf Range(Rank_Classes) = "上品" Then
        Range(Life_Classes).Validation.Delete
        Range(Life_Classes).Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:=Join(dPolitical.keys, ",")
        
        If dPolitical.exists(Range(Life_Classes).Value) Then '0点
            sTemp = Left(dPolitical(Range(Life_Classes).Value), Len(dPolitical(Range(Life_Classes).Value)) - 1)
            aTemp = Split(sTemp, ",")
            For i = 0 To 8
                Cells(cRow + i, cCol) = CInt(aTemp(i))
            Next i
        End If
    ElseIf Range(Rank_Classes) = "无" Then
        Range(Life_Classes).Validation.Delete
        Range(Life_Classes).Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:=Join(dNull.keys, ",")
        Range(Life_Classes).Value = "无"
        Range("D3").Value = 0
    End If
    
End Sub

Sub 生活职业成长值()
    '职业等级10级
    '平均1职业等级相当于种族5级
    '定义字典
    Dim aLifeJobs()
    Dim dRank As Object, dJobs As Object, dPolitical As Object
    Dim i%, i1%
    Const Life_Classes As String = "D2"
    Const Rank_Classes As String = "E2"
    aLifeJobs() = Sheets("生活职业库").Range("生活职业表").Value
    Set dRank = CreateObject("Scripting.Dictionary")
    Set dJobs = CreateObject("Scripting.Dictionary")
    Set dPolitical = CreateObject("Scripting.Dictionary")
    Dim rg As Range
    dRank("") = ""
    For Each rg In Sheets("参数表").Range("参数表[职业路线]")
        If Not dRank.exists(rg.Value) Then
            dRank(rg.Value) = ""
        End If
    Next
    dRank.Remove ("")
    Range(Rank_Classes).Validation.Delete
    Range(Rank_Classes).Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
    xlBetween, Formula1:=Join(dRank.keys, ",")
    
    
    For i = 1 To UBound(aLifeJobs)
        If aLifeJobs(i, 2) = "下品" Then
            For i1 = 3 To UBound(aLifeJobs, 2) - 1
                dJobs(aLifeJobs(i, 1)) = dJobs(aLifeJobs(i, 1)) & aLifeJobs(i, i1) & ","
            Next i1
            
        ElseIf aLifeJobs(i, 2) = "上品" Then
            For i1 = 3 To UBound(aLifeJobs, 2) - 1
                dPolitical(aLifeJobs(i, 1)) = dPolitical(aLifeJobs(i, 1)) & aLifeJobs(i, i1) & ","
            Next i1
        End If
    Next i
    
    Dim cCol%, cRow%
    
    Dim sTemp$, aTemp() As String
    cRow = 6
    cCol = 5
    '下面是生活职业，属于奴隶技能
    '生活职业每级会给人物带来2.5属性
    '必须有一项属性-1法则
    
    
    If Range(Rank_Classes) = "下品" Then
        Range(Life_Classes).Validation.Delete
        Range(Life_Classes).Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:=Join(dJobs.keys, ",")
        
        If dJobs.exists(Range(Life_Classes).Value) Then  '0点
            sTemp = Left(dJobs(Range(Life_Classes).Value), Len(dJobs(Range(Life_Classes).Value)) - 1)
            aTemp = Split(sTemp, ",")
            For i = 0 To 8
                Cells(cRow + i, cCol) = CInt(aTemp(i))
            Next i
        End If
        
    ElseIf Range(Rank_Classes) = "上品" Then
        Range(Life_Classes).Validation.Delete
        Range(Life_Classes).Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:=Join(dPolitical.keys, ",")
        
        If dPolitical.exists(Range(Life_Classes).Value) Then '0点
            sTemp = Left(dPolitical(Range(Life_Classes).Value), Len(dPolitical(Range(Life_Classes).Value)) - 1)
            aTemp = Split(sTemp, ",")
            For i = 0 To 8
                Cells(cRow + i, cCol) = CInt(aTemp(i))
            Next i
        End If
    End If
    
End Sub
